perm filename MPRNT.F4[XX,LCS]7 blob
sn#208661 filedate 1976-03-26 generic text, type T, neo UTF8
00100 C MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200 C *** READS DATA FROM DSK FOR VARIOUS THINGS.
00400
00500 IMPLICIT INTEGER(A-Q,S-Z)
00600 REAL DIS,DISX,A,B,STFF,CENTR,POS,BOT,TOP,TOP2,TOTAL
00700 COMMON /DL/IXRX,SAVER,NAME /FRMT/F78F(1),FA1(1),FA5(1),ASK
00800 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00950 C ↓↓↓↓↓ V IS FOR READIN ONLY
01000 COMMON /XRN/RN(3000),V(1000) /ALF/INP(72),ML
01050 1 /STF/RSTFAC(-3/4),RSTJ2 /POSI/STFF(-3/4),JJ2,POS
01150 1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
01160 1/PLTR/PLT,RHT,DIS
01400 EQUIVALENCE (J3,JQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(POS,IPOS)
01500 1,(R6,RJQ(4)),(R7,RJQ(5)),(R9,RJQ(7)),(J10,JQ(8)),(RX3,RJQ(20))
01600 1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1)),(R8,RJQ(6))
01900 DATA IP/'P'/,FA1/'( A1)'/
01910
01912 CALL SEGFIX
01914 C TO ENABLE MULTIPLE USE OF UPPER SEGMENT (TVR)
01920 TOTAL=0
01925 RPLT=-999.
01927 C RPLT WILL BE FOR HEAVY STAFF LINES.
01930 23 TYPE 21
01940 21 FORMAT(' RESET BOTTOM? '$)
01950 ACCEPT FA1,K
01960 IF(K.EQ.'A')GO TO 124
01970 IF(K.EQ.'P')GO TO 123
01980 C TYPE 'P' FOR PRIM FONT ONLY. 'A' FOR ALL, IF RESET IS NEEDED.
01985 GO TO 24
01990 123 JFONT=-1
02000 GO TO 23
02010 124 JFONT=0
02015 GO TO 23
02020 24 IF(K.EQ.'N')GO TO 22
02030 C 'Y' OR <CR>=ABSOLUTE LOW POINT OF FILE WILL BE AT
02040 C STARTING PEN POS.
02050 C 'N'= BOTTOM OF STAFF 0 WILL BE AT STARTING PEN POS.
02060 TOP2=-999
02200 RNOMOV=0
02300 22 I1=0
02400 C RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
02700 2 TOP=-999
02800 BOT=999
02900 20 PLT=0
02910 PLOTIT=0
03000 CC PWDS(1)=1.
03100 EDX=-1
03200 CC DO 1402 K=-3,4
03300 CC1402 RSTFAC(K)=1.
03400 M=1
03500 CC ITEM=0
03700 CC I=1
03900 GO TO 5504
04000
04100
04200 11 CALL NOTWRT
04300 57 IF(PLT)GO TO 6120
04400 ITEM=ITEM+1
04500 IF(EDX.EQ.-1)GO TO 77
04550 IF(M.LT.I)GO TO 6120
04600 77 IF(PLOTIT.EQ.-2)GO TO 2311
04700 CZZ PWDS(ITEM+1)=I
05000
05100 5504 IF(I1.EQ.IP)GO TO 2311
05320 I1=IP
05340 INP(2)='X'
05400 311 JA=0
05500 CC IF(I1.NE.IP)GO TO 85
05600 2311 CALL PLTCMD
05650 IF(INP(2).EQ.-1)GO TO 30
05700 IF(PLOTIT.EQ.0)GO TO 3005
05800 I1=IP
05900 PLOTIT=-1
06000 C 'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
06200
06300 6531 M=1
06400 EDX=-1
06500 DO 5532 K=1,9
06600 5532 JQ(K)=RJQ(K)
06700 CC590 IF(PLOTIT.EQ.-1)GO TO 121
06750 IF(PLOTIT.EQ.-1)GO TO 5121
06800 590 I1=0
07000 C TO RUN THROUGH DATA.
07200 CC243 R2=0
07300 CC R3=0
07400 CC R4=0
07500 TOP=-999
07600 BOT=999
07700 C GOES TO PLOTTER
07800 85 M=1
07900 CC I=PWDS(ITEM+1)
08000 ITEM=0
08100 8852 PLT=1
08200 EDX=0
08400 GO TO 6120
08500
08510 30 A=TOTAL/200.0
08520 TYPE 300,A
08530 CALL PLOT(0,0,99)
08540 C THE END OF THE DATA
08550 300 FORMAT(F7.2,' INCHES')
08560
08600 60 J2=R2
08610 IF(J2.LT.5)GO TO 16
08620 IF(J2.GT.-4)GO TO 16
08630 TYPE 160,J2
08640 GO TO 57
08650 160 FORMAT(' ILLEGAL STAFF# ',I4)
09050 16 RSTJ2=RSTFAC(J2)
09100 5541 POS=STFF(J2)
09110 IF(JA.NE.16)GO TO 61
09115 IF(R5.GE.100)R5=R5-100
09117 C >100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEPPPARTS.c
09120 IF(J10.NE.1)GO TO 62
09130 R3=RWD3
09135 C POSITIONS TEXT ITEMS.
09140 62 RWD3=R5*RSTJ2*R9+R3
09170 61 RX3=R3
09200 J3=ROFF(RHORZ(R3))
09300 C LINE IS DIVIDED INTO 200 POINTS.
09400 CALL CENTX
09434 C SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
09468 R3=J3
09502 IF(JA.LE.2)GO TO 11
09536 551 GO TO(11,11,68,25,67, 625,116,125,11,69, 68,67),JA
09570 GO TO (116,81,80),JA-15
09604 C FOR 16,17,18 (WORDS, KSIG, METER)
09652 TYPE 5700,JA
09676 5700 FORMAT(' UNKNOWN CODE=',I3)
09700 GO TO 57
09800 C TRAP FOR UNKNOWN CODE #S (SUCH AS 99 - FOR "NO KSIG".
09808
09842 69 CALL MAKNUM(R5)
09876 GO TO 57
09910
09944 68 CALL CLEFS
09978 GO TO 57
10012
10046 67 CALL SLUR
10080 GO TO 57
10114
10148 116 CALL ALPHA
10182 GO TO 57
10216
10250 81 CALL KSIG
10284 GO TO 57
10318
10352 80 CALL METER
10386 GO TO 57
10420
10500 125 IF(R2.EQ.0)RMOV=R8
10510 625 CALL BMSTF
10515 C BEAMS AND STAVES
10520 GO TO 57
10530
10556 25 CALL ITMSUB
10590 C BAR LINES AND SEVERAL OTHER KINDS OF LINES.
10624 GO TO 57
11100
11200 CC3005 REWIND 21
11300 C GUARDS AGAINST LOSSAGE!
11350 3005 IF(RPLT.EQ.-999.)RPLT=R9
11360 C R9=1 FOR HEAVY STAFF LINES. (FOR XGP)
11400 PLOTIT=-2
11500 CC CALL IFILE(21,NAME)
11550 CALL GETFI2(NAME,-1)
11600 C JUMP TO READ BIG FILES
11700 CC2200 J=ITEM+1
11710 CALL FASTI2(RSTFAC,128)
11720 CALL FASTI2(PWDS,JJ2)
11730 CALL FASTI2(RN,IPOS)
11740 ITEM=JJ2-2
11750 I=IPOS
11800 CC2202 READ(21),ITEM,I,(PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1)
11900 CC 1 ,JA,(V(K),K=1,JA),JA,(V(K),K=1,JA),RSTFAC,STFF
12000 CC READ(21,END=2203)RSTFAC,STFF
12005 2203 IF(I.LE.2000)GO TO 590
12120 TYPE 4202,Y
12130 STOP
12140 4202 FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
12500 121 IF(PLOTIT.EQ.0)GO TO 5504
12600 5121 CALL PLTSRT
12700 C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
12800 PLT=-1
12850 IF(RPLT.NE.0)PLT=-2
12900 C (J8) P8=1 OR 2 FOR 2-PASS PLOTS
13200 CC IF(R2.EQ.0)R2=1.
13210 CALL NOZERO(R2)
13300 DIS=R2*1.24
13400 CXX IF(R3.EQ.0)R3=R2
13500 RHT=R3*1.2
13600 C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
13700 BOT=-BOT*RHT
13705 TOTAL=TOTAL-BOT
13710 CX IXGP=100+BOT
13800 IF(TOP2.EQ.-999)GO TO 8121
13900 BOT=BOT+TOP2
13950 IF(TOP2.EQ.0)BOT=0
14000 GO TO 9121
14200 8121 RNOMOV=0
14228 9121 IF(R7.EQ.0)R7=RMOV
14237 C RMOV HAS INCHES FROM P8 OF STAFF 0.
14246 IF(RNOMOV.GT.1)BOT=RNOMOV
14255 RNOMOV=R6+R7*200.*R3
14273 RMOV=0
14400 C R6=1 FOR NO MOVE AT END. R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
14600 C (J4) P4=1 FOR XGP OUTPUT
14720 IF(J5.NE.0)GO TO 6120
15000 C MOVES 0 POINT OVER EACH TIME.
15200 6121 CALL PLOT(0,IFIX(BOT),-3)
15300 C MOVES PLOTTER UP IF P5=0.
15500
15600 C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
15700 6120 IF(M.GE.I)GO TO 7120
15800 CALL RUNTHR(M)
17050 GO TO 60
17100
17200 7120 M=1
17300 CZ IF(EDX)GO TO 71201
17400 CZ IF(PLT.EQ.1)EDX=-1
17500 CZ PLT=0
17600 C RETURNS FOR 'SL'=SAVE LAST
17700 CZ GO TO 5504
17950 71201 A=TOP*RHT+50.*RHT
18000 IF(RNOMOV.NE.0)A=0
18100 IF(RNOMOV.GT.1)A=RNOMOV
18110 TOTAL=TOTAL+A
18200 CALL PLOT(0,IFIX(A),3)
18225 IF(RNOMOV.EQ.1)GO TO 20
18237 C PRESERVES TOP AND BOT IF RNOMOV
18250 CX CALL PLOT(0,TOP+IXGP,3)
18275 TOP=A
18300 TOP2=TOP
18400 GO TO 2
18500 C TO MOVE 'PLOTTER' FOR XGP OUTPUT
18600 C MOVES PLOTTER UP
18700 C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
18800
19000 END